home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / QAlerts.p < prev    next >
Encoding:
Text File  |  1993-12-16  |  6.5 KB  |  245 lines  |  [TEXT/PJMM]
  1. unit QAlerts;
  2.  
  3. (* # Copyright Department of Computer Science *)
  4. (* # University of Western Australia *)
  5. (* # Created : Quinn *)
  6. (* # Station : Eriodon *)
  7. (* # Date : Thursday, 16 December 1993 *)
  8.  
  9. interface
  10.  
  11.     procedure QParamText (p0, p1, p2, p3: Str255);
  12.  
  13.     (* These are all procedures because they happen async and you can't get the button back. *)
  14.     (* You could always do some extreme hackery with the filter proc! *)
  15.  
  16.     procedure QAlert (id: integer; filter: ModalFilterProcPtr);
  17.     procedure QNoteAlert (id: integer; filter: ModalFilterProcPtr);
  18.     procedure QCautionAlert (id: integer; filter: ModalFilterProcPtr);
  19.     procedure QStopAlert (id: integer; filter: ModalFilterProcPtr);
  20.  
  21.     procedure QAlertIdle (in_foreground: boolean);
  22.  
  23.     function InitQAlerts (icon_id: integer; icon_ndx: integer; sound: Handle; str: Str255): OSErr;
  24.     procedure TermQAlerts;
  25.  
  26. implementation
  27.  
  28.     uses
  29.         Notification;
  30.  
  31.     type
  32.         smallIcon = packed array[0..31] of byte;
  33.         smallIconArray = array[1..1000] of smallIcon;
  34.         smallIconPtr = ^smallIconArray;
  35.         smallIconHandle = ^smallIconPtr;
  36.  
  37.     type
  38.         alertKind = (aAlert, aNote, aCaution, aStop);
  39.         alertHandle = ^alertPtr;
  40.         alertPtr = ^alertRecord;
  41.         alertRecord = record
  42.                 kind: alertKind;
  43.                 id: integer;
  44.                 filter: ModalFilterProcPtr;
  45.                 params: array[0..3] of StringHandle;
  46.                 next: alertHandle;
  47.             end;
  48.  
  49.     var
  50.         note: NMRec;
  51.         my_icon: Handle;
  52.         my_sound: Handle;
  53.         my_string: Str255;
  54.         current_params: array[0..3] of StringHandle;
  55.         alerts: alertHandle;
  56.  
  57.     procedure QParamText (p0, p1, p2, p3: Str255);
  58.     begin
  59.         SetString(current_params[0], p0);
  60.         SetString(current_params[1], p1);
  61.         SetString(current_params[2], p2);
  62.         SetString(current_params[3], p3);
  63.     end; (* QParamText *)
  64.  
  65.     procedure InternalAlert (kind: alertKind; id: integer; filter: ModalFilterProcPtr);
  66.         var
  67.             err: OSErr;
  68.             this_alert: alertHandle;
  69.             i: integer;
  70.             tmpstrh: StringHandle;
  71.             tmp: alertHandle;
  72.     begin
  73.         (* create the alertRecord *)
  74.         err := noErr;
  75.         this_alert := alertHandle(NewHandleClear(sizeof(alertRecord)));            (* Clear is important because it sets the params to nil *)
  76.         if this_alert = nil then begin
  77.             err := MemError;
  78.         end; (* if *)
  79.         (* and its strings *)
  80.         for i := 0 to 3 do begin
  81.             if err = noErr then begin
  82.                 tmpstrh := current_params[i];
  83.                 err := HandToHand(Handle(tmpstrh));
  84.                 if err = noErr then begin
  85.                     this_alert^^.params[i] := tmpstrh;
  86.                 end; (* if *)
  87.             end; (* if *)
  88.         end; (* for *)
  89.         if err = noErr then begin
  90.             (* now fill in other stuff *)
  91.             this_alert^^.kind := kind;
  92.             this_alert^^.id := id;
  93.             this_alert^^.filter := filter;
  94.             this_alert^^.next := nil;
  95.  
  96.             if alerts = nil then begin
  97.                 (* first alert, add it to the list (easy) then install the note *)
  98.                 alerts := this_alert;
  99.                 with note do begin    (* safe *)
  100.                     qType := nmType;
  101.                     nmMark := 1;                    (* mark current application in Apple menu *)
  102.                     nmIcon := my_icon;
  103.                     nmSound := my_sound;
  104.                     if my_string = '' then begin
  105.                         nmStr := nil;
  106.                     end
  107.                     else begin
  108.                         nmStr := @my_string;
  109.                     end; (* if *)
  110.                     nmResp := nil;
  111.                     nmRefCon := 0;
  112.                 end; (* with *)
  113.                 err := NMInstall(@note);
  114.             end
  115.             else begin
  116.                 (* subsequent alerts, add it to END of list *)
  117.                 tmp := alerts;
  118.                 while tmp^^.next <> nil do begin
  119.                     tmp := tmp^^.next;
  120.                 end; (* while *)
  121.                 tmp^^.next := this_alert;
  122.             end; (* if *)
  123.         end
  124.         else begin
  125.             (* tidy up *)
  126.             if this_alert <> nil then begin
  127.                 for i := 0 to 3 do begin
  128.                     if this_alert^^.params[i] <> nil then begin
  129.                         DisposeHandle(Handle(this_alert^^.params[i]));
  130.                     end; (* if *)
  131.                 end; (* for *)
  132.                 DisposeHandle(Handle(this_alert));
  133.             end; (* if *)
  134.         end; (* if *)
  135.     end; (* InternalAlert *)
  136.  
  137.     procedure QAlert (id: integer; filter: ModalFilterProcPtr);
  138.     begin
  139.         InternalAlert(aAlert, id, filter);
  140.     end; (* QParamText *)
  141.  
  142.     procedure QNoteAlert (id: integer; filter: ModalFilterProcPtr);
  143.     begin
  144.         InternalAlert(aNote, id, filter);
  145.     end; (* QParamText *)
  146.  
  147.     procedure QCautionAlert (id: integer; filter: ModalFilterProcPtr);
  148.     begin
  149.         InternalAlert(aCaution, id, filter);
  150.     end; (* QParamText *)
  151.  
  152.     procedure QStopAlert (id: integer; filter: ModalFilterProcPtr);
  153.     begin
  154.         InternalAlert(aStop, id, filter);
  155.     end; (* QParamText *)
  156.  
  157.     procedure QAlertIdle (in_foreground: boolean);
  158.         var
  159.             this_alert: alertHandle;
  160.             i: integer;
  161.             junk: integer;
  162.     begin
  163.         if in_foreground then begin
  164.             while alerts <> nil do begin
  165.                 this_alert := alerts;
  166.                 alerts := alerts^^.next;
  167.  
  168.                 HLock(Handle(this_alert));
  169.                 with this_alert^^ do begin (* unsafe, checked (this_alert locked)*)
  170.                     for i := 0 to 3 do begin
  171.                         HLock(Handle(params[i]));
  172.                     end; (* for *)
  173.                 (* individual params are locked so we can pass them dereferenced *)
  174.                     ParamText(params[0]^^, params[1]^^, params[2]^^, params[3]^^);
  175.                     for i := 0 to 3 do begin
  176.                         DisposeHandle(Handle(params[i]));
  177.                         params[i] := nil;
  178.                     end; (* for *)
  179.  
  180.                     case kind of
  181.                         aAlert: 
  182.                             junk := Alert(id, filter);
  183.                         aNote: 
  184.                             junk := NoteAlert(id, filter);
  185.                         aCaution: 
  186.                             junk := CautionAlert(id, filter);
  187.                         aStop: 
  188.                             junk := StopAlert(id, filter);
  189.                     end; (* case *)
  190.  
  191.                 end; (* with *)
  192.                 DisposeHandle(Handle(this_alert));
  193.             end; (* if *)
  194.             junk := NMRemove(@note);
  195.         end; (* if *)
  196.     end; (* QAlertIdle *)
  197.  
  198.     function InitQAlerts (icon_id: integer; icon_ndx: integer; sound: Handle; str: Str255): OSErr;
  199.         var
  200.             err: OSErr;
  201.             i: integer;
  202.             s: signedByte;
  203.             icons: smallIconHandle;
  204.     begin
  205.         my_sound := sound;
  206.         my_string := str;
  207.         my_icon := nil;
  208.         alerts := nil;
  209.         err := noErr;
  210.         for i := 0 to 3 do begin
  211.             current_params[i] := NewString('');
  212.             if current_params[i] = nil then begin
  213.                 err := memFullErr;
  214.             end; (* if *)
  215.         end; (* for *)
  216.         if err = noErr then begin
  217.             icons := smallIconHandle(GetResource('SICN', icon_id));
  218.             err := ResError;
  219.             if (icons = nil) and (err = noErr) then begin
  220.                 err := resNotFound;
  221.             end; (* if *)
  222.         end; (* if *)
  223.         if err = noErr then begin
  224.             s := HGetState(Handle(icons));
  225.             HLock(Handle(icons));
  226.             err := PtrToHand(@icons^^[icon_ndx], my_icon, sizeof(smallIcon));
  227.             HSetState(Handle(icons), s);
  228.         end; (* if *)
  229.         InitQAlerts := err;
  230.     end; (* InitQAlerts *)
  231.  
  232.     procedure TermQAlerts;
  233.         var
  234.             junk: OSErr;
  235.     begin
  236.         if alerts <> nil then begin
  237.             junk := NMRemove(@note);
  238.             alerts := nil;                        (* make sure we *never* try to remove it again *)
  239.         end; (* if *)
  240.         (* I'm not going to bother dispose all of the memory. *)
  241.         (* Basically you have to walk the alerts list doing the deed.  *)
  242.         (* Seeing as the app is about to terminate it's just a waste of code. *)
  243.     end; (* TermQAlerts *)
  244.  
  245. end.